{-# LANGUAGE OverloadedStrings, FlexibleContexts, RankNTypes #-}
module Controllers.Digestive where

import Happstack.Server
       (ok, Input, Response, FilterMonad, ServerMonad, HasRqData)
import Text.Digestive.Forms.Happstack (eitherHappstackForm)
import Text.Digestive.Types()
import Text.Digestive.Blaze.Html5 (childErrors)
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Pages.DigestiveHelpers (BlazeForm)
import Control.Monad (MonadPlus)
import Control.Applicative(Alternative)
import Pages.MasterPage(masterPage)
import Session(readSession)
import Text.Digestive ((++>))
import Happstack.Server.Response (ToMessage(..))
import Text.Digestive.Forms.Html (renderFormHtml)

runForm :: (HasRqData m, MonadPlus m, Alternative m, ServerMonad m, FilterMonad Response m) => (a -> m Response) -> BlazeForm m Input a -> m Response
runForm submitHandler form = do
    r <- eitherHappstackForm (childErrors ++> form) "upload-form"
    session <- readSession
    case r of
        Left form' -> ok $ toResponse $ do
            let (formHtml', enctype) = renderFormHtml form'
            masterPage session "a form" $ H.form ! A.enctype (H.toValue $ show enctype)
                   ! A.method "POST" $ do
                formHtml'
                H.input ! A.type_ "submit" ! A.value "Submit"
        Right submittedResult -> do
            submitHandler submittedResult
